#First we load our data into our environment
library(tidytuesdayR)
tuesdata <- tidytuesdayR::tt_load('2025-06-24')
## ---- Compiling #TidyTuesday Information for 2025-06-24 ----
## --- There are 2 files available ---
##
##
## ── Downloading files ───────────────────────────────────────────────────────────
##
## 1 of 2: "cases_month.csv"
## 2 of 2: "cases_year.csv"
cases_month <- tuesdata$cases_month
cases_year <- tuesdata$cases_year
#We start by
library(rayshader)
library(rgl)
library(av)
library(gifski)
library(magick)
## Linking to ImageMagick 6.9.12.98
## Enabled features: cairo, freetype, fftw, ghostscript, heic, lcms, pango, raw, rsvg, webp
## Disabled features: fontconfig, x11
library(ggplot2)
library(dplyr)
##
## Vedhæfter pakke: 'dplyr'
## De følgende objekter er maskerede fra 'package:stats':
##
## filter, lag
## De følgende objekter er maskerede fra 'package:base':
##
## intersect, setdiff, setequal, union
library(magrittr)
library(plotly)
##
## Vedhæfter pakke: 'plotly'
## Det følgende objekt er maskeret fra 'package:ggplot2':
##
## last_plot
## Det følgende objekt er maskeret fra 'package:stats':
##
## filter
## Det følgende objekt er maskeret fra 'package:graphics':
##
## layout
names(cases_month)
## [1] "region" "country" "iso3"
## [4] "year" "month" "measles_suspect"
## [7] "measles_clinical" "measles_epi_linked" "measles_lab_confirmed"
## [10] "measles_total" "rubella_clinical" "rubella_epi_linked"
## [13] "rubella_lab_confirmed" "rubella_total" "discarded"
names(cases_year)
## [1] "region"
## [2] "country"
## [3] "iso3"
## [4] "year"
## [5] "total_population"
## [6] "annualized_population_most_recent_year_only"
## [7] "total_suspected_measles_rubella_cases"
## [8] "measles_total"
## [9] "measles_lab_confirmed"
## [10] "measles_epi_linked"
## [11] "measles_clinical"
## [12] "measles_incidence_rate_per_1000000_total_population"
## [13] "rubella_total"
## [14] "rubella_lab_confirmed"
## [15] "rubella_epi_linked"
## [16] "rubella_clinical"
## [17] "rubella_incidence_rate_per_1000000_total_population"
## [18] "discarded_cases"
## [19] "discarded_non_measles_rubella_cases_per_100000_total_population"
cases_year <- cases_year %>%
mutate(region = recode(region, `AFRO` = "African Region", `AMRO` = "Regon of Americas", `EMRO` = "Eastern Mediterraenean Region", `EURO` = "European Region", `SEARO` = "Sout-East Asian Region", `WPRO` = "Western Pacific Region"))
cases_year %>%
group_by(year) %>%
mutate(avg_reg = mean(measles_incidence_rate_per_1000000_total_population))
## # A tibble: 2,382 × 20
## # Groups: year [14]
## region country iso3 year total_population annualized_population_m…¹
## <chr> <chr> <chr> <dbl> <dbl> <dbl>
## 1 African Region Algeria DZA 2012 37646166 37646166
## 2 African Region Algeria DZA 2013 38414172 38414172
## 3 African Region Algeria DZA 2014 39205031 39205031
## 4 African Region Algeria DZA 2015 40019529 40019529
## 5 African Region Algeria DZA 2016 40850721 40850721
## 6 African Region Algeria DZA 2017 41689299 41689299
## 7 African Region Algeria DZA 2018 42505035 42505035
## 8 African Region Algeria DZA 2019 43294546 43294546
## 9 African Region Algeria DZA 2020 44042091 44042091
## 10 African Region Algeria DZA 2021 44761099 44761099
## # ℹ 2,372 more rows
## # ℹ abbreviated name: ¹​annualized_population_most_recent_year_only
## # ℹ 14 more variables: total_suspected_measles_rubella_cases <dbl>,
## # measles_total <dbl>, measles_lab_confirmed <dbl>, measles_epi_linked <dbl>,
## # measles_clinical <dbl>,
## # measles_incidence_rate_per_1000000_total_population <dbl>,
## # rubella_total <dbl>, rubella_lab_confirmed <dbl>, …
cases_year %>%
group_by(year) %>%
mutate(avg_reg = mean(measles_incidence_rate_per_1000000_total_population)) %>%
ggplot(aes(x = year, y = avg_reg)) +
geom_point() +
theme_bw() +
labs(title = "Avg. measles incidence rate worldwide \n(pr. 1,000,000)", x = "Year", y = "Avg. Incidence Rate") +
geom_smooth()
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'
plotfacet <- cases_year %>%
group_by(year, region) %>%
mutate(avg_reg = mean(measles_incidence_rate_per_1000000_total_population)) %>%
ggplot() +
geom_point(aes(x = year, y = avg_reg, colour = region, shape = region)) +
theme_bw() +
labs(title = "Avg. measles incidence rate pr. region pr. year(pr. 1,000,000)", x = "Year", y = "Avg. Incidence Rate", color = "Region", shape = "Region") +
geom_smooth(aes(x = year, y = avg_reg), color = "grey", se=FALSE, show.legend = FALSE) +
facet_wrap(~ region, scales = "free") +
geom_line(aes(x = year, y = avg_reg, colour = region, shape = region))
## Warning in geom_line(aes(x = year, y = avg_reg, colour = region, shape =
## region)): Ignoring unknown aesthetics: shape
ggplotly(plotfacet)
## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'
cases_year1 <- cases_year %>%
group_by(year, region) %>%
mutate(avg_reg = mean(measles_incidence_rate_per_1000000_total_population))
hexgg <- ggplot(cases_year1, aes(x = year, y = avg_reg)) +
stat_bin_hex(aes(fill = after_stat(density), colour = after_stat(density)),
bins = 10,
linewidth = 1) +
scale_fill_viridis_c(option = "B") +
scale_color_viridis_c(option = "B", guide = "none") +
labs(x = "Year", y = "Avg. incidence rate pr. region", fill = "",
colour = "") +
theme_minimal()
hexgg
plot_gg(hexgg, multicore = TRUE, windowsize = c(800, 800))
render_movie("silly.gif")
## [1] "C:\\Users\\au483794\\OneDrive - Aarhus universitet\\Documents\\Fridayproject\\Peter\\silly.gif"
cases_month %>%
mutate(region = as.factor(region)) %>%
ggplot(aes(x = measles_suspect, y = measles_lab_confirmed, color = region)) +
geom_point() +
facet_wrap(~region) +
theme_bw()
## Warning: Removed 148 rows containing missing values or values outside the scale range
## (`geom_point()`).
